home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 26 / 3 / DISK2635.ZIP / MAKE.ZIP / LIBMAKE.BAS next >
BASIC Source File  |  1990-09-15  |  7KB  |  218 lines
  1.  
  2. 'Note: This is an Include File for MAKE.BAS
  3. 'To create MAKE.EXE, Compile MAKE.BAS
  4. '------------------------------------------------------------------------
  5. 'File: LibMake.Bas
  6. 'Purpose: Library of functions needed for Make utility
  7. '
  8. 'FUNCTION BINTODEC!(BinaryString$) 'RETURNS: Decimal equivelent of binary string
  9. 'SUB DTSTAMP$(FileName$,date$,time$)'RETURNS: Date and Time of last change
  10. 'FUNCTION FIGDATE&(DATE$)          'IN: DATE$ = mm/dd/yy RETURNS: Julian Date
  11. 'DEF FNFILEEXISTS (FileName$)      'RETURNS: True if file exists
  12. 'FUNCTION GETFILENAME$             'RETURNS:Project main file name
  13. 'FUNCTION JULIAN#(D$,T$)           'RETURNS: pseudo julian time/date stamp
  14. 'SUB NOISE                         'Makes noise
  15. 'SUB WAITING                       'Process hit any key to continue
  16.  
  17. '------------------------------------------------------------------------
  18. DEFINT A-Z
  19. 'Define register constants
  20. %AX=1 : %BX=2 : %CX=3 : %DX=4 : %SI=5 : %DI=6 : %BP=7 : %DS=8 : %ES=9: %FLAGS=0
  21. SUB DTSTAMP(FL$,D$,T$)
  22.    'This sub returns the date and time stamp
  23.    'In: fl$ = file name
  24.    'Out: d$=date as mm/dd/yy
  25.      't$ = time as hr:mn:sc
  26.    '1st open file to get it's handle for next part
  27.    MAP BinBuff$$*16   'This makes sure that binary string is 16 characters
  28.  
  29.    Buf$=FL$+CHR$(0)       'ASCIIZ String
  30.    REG %AX,&H3D02    'DOS Open File Function
  31.    REG %DS, STRSEG(Buf$)
  32.    REG %DX, STRPTR(Buf$)
  33.    CALL INTERRUPT &H21  'Call DOS
  34.    'if not on file, assign a time of 0 so it gets recompilied
  35.    IF (REG(%FLAGS) AND 1) <> 0 THEN D$="00/00/00" :T$="00:00:00":EXIT SUB
  36.    HANDLE = REG(%AX)   'Now AX holds file handle
  37.  
  38.    'Get file date and time
  39.    REG %AX,&H5700   'DOS Get time and date function
  40.    REG %BX,HANDLE   'Handle to file Fl$
  41.    CALL INTERRUPT &H21
  42.    TM= REG(%CX)    'Time (encoded)
  43.    DT = REG(%DX)  'Date (encoded)
  44.  
  45.    'Now close file
  46.    REG %AX,&H3E00  'DOS Close file function
  47.    REG %BX,HANDLE  'BX
  48.    CALL INTERRUPT &H21
  49.  
  50.    'Now uncode date and time
  51.    RSET BinBuff$$=BIN$(TM)   'This insures 16 digits
  52.  
  53.     Hours$ = BinBuff$$
  54.     RSET BinBuff$$=BIN$(DT)
  55.     Dt$ = BinBuff$$
  56.     Hrs%=CINT(BINTODEC!(MID$(Hours$,1,5)))   'Hours
  57.     Mns%=CINT(BINTODEC!(MID$(Hours$,6,6)))   'Minutes
  58.     Scs%=CINT(BINTODEC!(MID$(Hours$,12)))*2  'Seconds were in 2 sec intervals
  59.  
  60.     Yr$ =MID$(Dt$,1,7)
  61.     Yr% = CINT(BINTODEC!(Yr$))+80  'YEAR IS OFFSERT FORM 1980
  62.     Mn$=MID$(Dt$,8,4)
  63.     Mn% =CINT(BINTODEC!(Mn$))       'MONTH
  64.     Dy$=MID$(Dt$,12,6)
  65.     Dy% =CINT(BINTODEC!(Dy$))        'DAY
  66.  
  67.     'Make up date string as: MM/DD/Yr
  68.     MAP DtString$$*8
  69.     DtString$$ = "00/00/00"
  70.     MID$(DtString$$,1,2)=RIGHT$("00"+REMOVE$(STR$(Mn%)," "),2)
  71.     MID$(DtString$$,4,2)=RIGHT$("00"+REMOVE$(STR$(Dy%)," "),2)
  72.     MID$(DtString$$,7,2)=RIGHT$("00"+REMOVE$(STR$(Yr%)," "),2)
  73.     D$=DtString$$  'DATE
  74.  
  75.     'Reuse DtString to make time string
  76.     DtString$$="00:00:00"
  77.     MID$(DtString$$,1,2)=RIGHT$("00"+REMOVE$(STR$(Hrs%)," "),2)
  78.     MID$(DtString$$,4,2)=RIGHT$("00"+REMOVE$(STR$(Mns%)," "),2)
  79.     MID$(DtString$$,7,2)=RIGHT$("00"+REMOVE$(STR$(Scs%)," "),2)
  80.     T$=DtString$$   'Time String
  81. END SUB
  82. '------------------------------------------------------------------------
  83. FUNCTION FIGDATE&(A$)
  84.    'This function was "appropriated" from Howard Balinger's HBLIB file
  85.    'on Compuserve
  86.   LOCAL A#, M%, D%, Y&, LpYrDys%, W&, A&, B%
  87.   M% = VAL(LEFT$(A$,2))
  88.   D% = VAL(MID$(A$,4,2))
  89.   Y& = VAL(RIGHT$(A$,2))
  90. SELECT CASE M%
  91.     CASE <1, >12
  92.       GOTO FIGDATEError
  93.     CASE 1,3,5,7,8,10,12
  94.       IF D% < 1 OR D > 31% THEN FIGDATEError
  95.     CASE 4,6,9,11
  96.       IF D% < 1 OR D% > 30 THEN FIGDATEError
  97.     CASE 2
  98.       IF Y&/4 = FIX(Y&/4) AND Y& <> 0 THEN
  99.         IF D% < 1 OR D% > 29 THEN FIGDATEError
  100.       ELSE
  101.         IF D% < 1 OR D% > 28 THEN FIGDATEError
  102.            END IF: END SELECT
  103.   IF Y& = 0 AND M% < 3 THEN GOTO DateRealOld
  104.   IF M% < 3 THEN DECR Y&
  105.   A& = FIX(Y&/4): W& = 1461 * A&: A& = Y& - 4*A&
  106.   W& = W& + 365 * A&
  107.   SELECT CASE M%
  108.     CASE 3
  109.       B% = 0
  110.     CASE 4
  111.       B% = 31
  112.     CASE 5
  113.       B% = 61
  114.     CASE 6
  115.       B% = 92
  116.     CASE 7
  117.       B% = 122
  118.     CASE 8
  119.       B% = 153
  120.     CASE 9
  121.       B% = 184
  122.     CASE 10
  123.       B% = 214
  124.     CASE 11
  125.       B% = 245
  126.     CASE 12
  127.       B% = 275
  128.     CASE 1
  129.       B% = 306
  130.     CASE 2
  131.       B% = 337
  132.  END SELECT
  133.  FIGDATE& = W& + B% + D% + 59: EXIT FUNCTION
  134. DateRealOld:
  135.  IF M% = 2 THEN FIGDATE& = D%+31 ELSE FIGDATE& = D%
  136. EXIT FUNCTION
  137.  FIGDATEError:
  138.    FIGDATE& = 0
  139. END FUNCTION
  140. '------------------------------------------------------------------------
  141. FUNCTION BINTODEC!(B$)
  142.   'returns decimal equivelent of binary string
  143.    L = LEN(B$)
  144.    Total = 0
  145.    Pointer=L
  146.    FOR I = 1 TO L
  147.       DIGIT$=MID$(B$,I,1)
  148.       DECR Pointer
  149.       Total=Total+(VAL(DIGIT$)*2^Pointer)
  150.    NEXT I
  151.    BINTODEC!=Total
  152. END FUNCTION
  153. '------------------------------------------------------------------------
  154. FUNCTION GETFILENAME$
  155.     'Returns main project filename
  156.     'Assumes .Bas if not specified
  157.     '1st see if command line parameter was passed
  158.     LOCAL F$  'Filename
  159.     F$ = COMMAND$
  160.     IF F$="" THEN  'GET A NAME
  161.     PRINT
  162.     PRINT "Enter Main File Filename (.BAS is assummed if not specified):";
  163.     INPUT F$
  164.     END IF
  165.     'Check for extension
  166.     Ext=INSTR(F$,".")
  167.     IF Ext=0 THEN F$=F$+".BAS"
  168.     GETFILENAME$=F$
  169. END FUNCTION
  170. '------------------------------------------------------------------------
  171. DEF FNFILEEXISTS (FileSpec$)
  172.  
  173.   FileSpec1$ = FileSpec$ + CHR$(0)
  174.   FileAttribute% = 0
  175.   REG %AX, &H4E00
  176.   REG %CX, FileAttribute%
  177.   REG %DS, STRSEG(FILESPEC1$)
  178.   REG %DX, STRPTR(FILESPEC1$)
  179.   CALL INTERRUPT &H21
  180.   IF (REG(%FLAGS) AND 1) = 0 THEN
  181.     FNFILEEXISTS = -1
  182.   ELSE
  183.     FNFILEEXISTS = 0
  184.   END IF
  185. END DEF 'FILEEXISTS
  186.  
  187. '------------------------------------------------------------------------
  188. FUNCTION JULIAN#(D$,T$)
  189.   'Creates pseudo julian time/date stamp
  190.   'used to compare creation times
  191.   'IN: D$ = Date String, T$ = Time String
  192.     J&=FIGDATE&(D$)  'Get Julian Date
  193.     'Now get fraction of day
  194.     'T$ is now in form of  HH:MM:SS
  195.  Seconds# =(CDBL(VAL(LEFT$(T$,2)))*60*60)+(VAL(MID$(T$,4,2))*60)+(VAL(RIGHT$(T$,2)))
  196.  'figure part of day that past
  197.  PT#=Seconds#/(60*60*24)     'Divide seconds by # of seconds in a day
  198.  'Add it up
  199.   JULIAN#=J&+PT#
  200.  END FUNCTION
  201. '-------------------------------------------------------------------------
  202. SUB WAITING
  203.    BEEP
  204.    A$ = INKEY$  'Clear previous keystrokes into dummy variable
  205.    PRINT"    < < <    Hit any key to continue ! ! ! > > > "
  206.    WHILE NOT INSTAT:WEND
  207.    A$ = INKEY$  'Clear  keystrokes into dummy variable
  208. END SUB
  209. '-------------------------------------------------------------------------
  210.  
  211. SUB NOISE
  212.  FOR I% = 1 TO 2
  213.     FOR X% = 57 TO 59
  214.     PLAY "L64 N="+VARPTR$(X%)
  215.     NEXT X%
  216.  NEXT I%
  217. END SUB
  218.